PC go! 2008 April/PCgo 2008-04 (DVD).iso/interface/contents/demoversionen_3846/13664/files/Data1.cab/turbocad_test1.vbs

Text File | 2001-10-16 | 6.8 KB | 360 lines

Option Explicit

Dim tcApp
Dim tcDwg

Dim TORADIANS
Dim bContinue

'================== ShowDrawings ========================================
Sub ShowDrawings()
      Dim cnt
    Dim tcDwgs
    Dim tcDwg
    Dim strMsg

    Set tcDwgs = tcApp.Drawings
    cnt = tcDwgs.Count
    MsgBox "Drawings count: " & CStr(cnt)

    If (cnt = 0) Then
        bContinue = False
        Exit Sub
    End If

    For Each tcDwg in tcDwgs
        strMsg = strMsg & tcDwg.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================== ShowFilters ========================================
Sub ShowFilters()
    Dim tcFlts
    Dim tcFlt
    Dim strMsg

    Set tcFlts = tcApp.Filters
    MsgBox "Filters count: " & CStr(tcFlts.Count)

    For Each tcFlt in tcFlts
        strMsg = strMsg & tcFlt.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================= ShowRegenMethods =========================================

Sub ShowRegens()
    Dim tcRms
    Dim tcRm
    Dim strMsg

    Set tcRms = tcApp.RegenMethods
    MsgBox "Regen Methods count: " & CStr(tcRms.Count)

    For Each tcRm in tcRms
        strMsg = strMsg & tcRm.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================= ShowTieMethods =========================================
Sub ShowTieMethods()

    Dim tcTms
    Dim tcTm
    Dim strMsg

    Set tcTms = tcApp.TieMethods
    MsgBox "Tie Methods count: " & CStr(tcTms.Count)

    For Each tcTm in tcTms
        strMsg = strMsg & tcTm.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================= ShowRenders =========================================
Sub ShowRenders()
    Dim tcRnds
    Dim tcRnd
    Dim strMsg

    Set tcRnds = tcApp.Renders
    MsgBox "Renders count: " & CStr(tcRnds.Count)

    For Each tcRnd in tcRnds
        strMsg = strMsg & tcRnd.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================ AddGraphics ==========================================
Sub AddGraphics(tcGrs)

Dim tcGr1
Dim tcGr2

    MsgBox "Graphics count: " & CStr(tcGrs.Count)

    Set tcGr1 = tcGrs.AddArcCenterAndPoint(0, 0, 0, 1, 1, 0, 0, 90 * TORADIANS)

'    tcGr1.MoveAbsolute 1, 1, 0

    Set tcGr2 = tcGrs.AddArcCenterAndPoint(0, 0, 0, 2, 2, 0, 0, 90 * TORADIANS)
    tcGr2.Properties("PenColor") = RGB(255, 128, 64)
    tcGrs.Remove tcGr2.Index
    tcGrs.AddGraphic tcGr2, tcGr1.Index

    MsgBox "Graphics count: " & CStr(tcGrs.Count)

End Sub

'================ CreateBlock ==========================================
Sub CreateBlock(tcGrs)
Dim tcDwg

    Set tcDwg = tcGrs.Drawing
    MsgBox "Blocks count: " & tcDwg.Blocks.Count

    tcGrs.CreateBlock "MyBlock"

    MsgBox "Blocks count: " & tcDwg.Blocks.Count

End Sub

'================ CreateXRefBlock ========================================
Sub CreateXRefBlock(tcDwg)
    Dim tcBlks

    Set tcBlks = tcDwg.Blocks
    MsgBox "Blocks count: " & tcBlks.Count

    tcBlks.AddXRef "", "e:\tc70\bin\usa\drawing\drawing1.tcw"

    MsgBox "Blocks count: " & tcBlks.Count

End Sub

'================ ViewZoom ================================================
Sub ViewZoom(tcVw)

Dim tcCam
Dim xC
Dim yC
Dim w
Dim h
Dim ZOOM_FACTOR

    ZOOM_FACTOR = 1.2

    If (tcVw.SpaceMode = 1) Then

        Set tcCam = tcVw.Camera
        tcCam.Zoom ZOOM_FACTOR
        MsgBox "Zoom"

    Else

        w = tcVw.ViewWidth
        h = tcVw.ViewHeight

        xC = tcVw.ViewLeft + w / 2
        yC = tcVw.ViewTop - h / 2

        w = w * ZOOM_FACTOR
        h = h * ZOOM_FACTOR

        tcVw.Update = False
        tcVw.ViewLeft = xC - w / 2
        tcVw.ViewTop  = yC + h / 2

        tcVw.Update = True

    End If

    MsgBox "Zoom"

    tcVw.Update = False
    tcVw.Margins = True
    tcVw.ZoomToExtents
    MsgBox "Zoom All"

End Sub

'================ ShowAppInfo ================================================
Sub ShowAppInfo()
Dim cnt

    tcApp.Visible = True

'    MsgBox "Current Snap modes: " & CStr(tcApp.SnapModes)

    ShowRegens
'    ShowRenders
'    ShowFilters
'    ShowTieMethods
'    ShowDrawings

    bContinue = False
End Sub

'================ EditDrawing ================================================
Sub MirrorSelection (tcDwg)

Dim tcMtx

Dim tcVw
Dim tcPickRes

Dim tcSelection
Dim tcBBox

Dim tcGr
Dim tcGrM
Dim tcVrt0
Dim tcVrt1

Dim xC
Dim yC
Dim zC
Dim angle
Dim dx
Dim dy
Dim dz


    Set tcSelection = tcDwg.Selection
    if (tcSelection.Count = 0) then exit sub

    MsgBox "Click mirror line"
    Set tcVw = tcDwg.ActiveView
    tcVw.GetMouseClick xC, yC

    Set tcPickRes = tcVw.PickPoint(xC, yC)
    if (tcPickRes.Count = 0) then exit sub

    Set tcVrt0 = tcPickRes(0).ClosestVertex
    tcVw.WorldToView tcVrt0.X, tcVrt.Y, tcVrt.Z, xC, yC, zC

    Set tcGr = tcPickRes(0)
    tcGr.GetDistance xC, yC, zC, , tcGrM

    Set tcVrt0 = tcGrm.Vertices(0)
    Set tcVrt1 = tcGrM.Vertices(1)

    dx = tcVrt1.X - tcVrt0.X
    dy = tcVrt1.Y - tcVrt0.Y
    if dx = 0 then
        angle = - 90 * TORADIANS
    else
        angle = -Atn(dy / dx)
    end if

'    Set tcBBox = tcSelection.CalcBoundingBox
'    xC = (tcBBox.Min.X + tcBBox.Max.X) / 2
'    yC = (tcBBox.Min.Y + tcBBox.Max.Y ) / 2
'    yC = (tcBBox.Min.Z + tcBBox.Max.Z ) / 2

    Set tcMtx = CreateObject("TurboCAD.Matrix")
'    tcMtx.TranslateScaleAndRotateZ 8, 8, 0,  1, 1, 1, 360 * TORADIANS
'    tcMtx.Translate 8, 8, 0


'    for each tcGr in tcSelection
'        tcGr.MoveRelative 8, 8, 0
'        tcGr.Update
'        tcGr.Select
'    next

    for each tcGr in tcSelection
        tcGr.RotateAxis angle, 0, 0, 1, tcVrt0.X, tcVrt0.Y, tcVrt0.Z
        tcGr.Update
        tcGr.Select
    next

'    for each tcGr in tcSelection
'        tcGr.RotateAxis -90 * TORADIANS, 0, 0, 1
'        tcGr.Update
'        tcGr.Select
'    next

    Set tcBBox = tcSelection.CalcBoundingBox
    xC = (tcBBox.Min.X + tcBBox.Max.X) / 2
    yC = (tcBBox.Min.Y + tcBBox.Max.Y ) / 2
    yC = (tcBBox.Min.Z + tcBBox.Max.Z ) / 2

    tcMtx.Identity
    tcMtx.TranslateScaleAndRotateZ 0, 0, 0, -1, 1, 1, 360 * TORADIANS, xC, yC, zC

    for each tcGr in tcSelection
        tcGr.Transform tcMtx
        tcGr.Update
        tcGr.Select
    next
end sub

'================ EditDrawing ================================================
Sub EditDrawing(tcDwg)
Dim tcGrs

    Set tcGrs = tcDwg.Graphics

    AddGraphics tcGrs
'    CreateBlock tcGrs
'    CreateXRefBlock tcDwg
'    MirrorSelection tcDwg

    ViewZoom tcDwg.ActiveView
End Sub

'================ CloseDrawing ================================================
Sub CloseDrawing(tcDwg)

    tcDwg.Close False

End Sub


'================ Main =================================================
Sub Main ()

    Set tcApp = CreateObject("TurboCAD.Application")
'    Set tcDwg = CreateObject("TurboCAD.Drawing")
'    Set tcApp = tcDwg.Application
    tcApp.Visible = false
    tcApp.Visible = true

    ShowAppInfo

    If (bContinue = False) Then
        Exit Sub
    End If

'    EditDrawing tcDwg
'    CloseDrawing tcDwg

'    ShowDrawings

End Sub

    TORADIANS = 3.14159265358979 / 180
    bContinue = True

    Main

'    tcApp.Quit

    MsgBox "Done"